Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/vblha1/getfile.frm

Text File | 1995-12-05 | 13KB | 579 lines

VERSION 2.00
Begin Form frmGetFile
   AutoRedraw      =   -1  'True
   Caption         =   "Select a file"
   ClientHeight    =   4170
   ClientLeft      =   1530
   ClientTop       =   1500
   ClientWidth     =   6360
   Height          =   4575
   Left            =   1470
   LinkTopic       =   "Form1"
   ScaleHeight     =   4170
   ScaleWidth      =   6360
   Top             =   1155
   Width           =   6480
   Begin PictureBox picLZHenter
      Height          =   615
      Left            =   6840
      Picture         =   GETFILE.FRX:0000
      ScaleHeight     =   585
      ScaleWidth      =   465
      TabIndex        =   21
      Top             =   3120
      Width           =   495
   End
   Begin PictureBox picLZH
      BorderStyle     =   0  'None
      Height          =   495
      Left            =   5160
      ScaleHeight     =   495
      ScaleWidth      =   495
      TabIndex        =   19
      Top             =   3600
      Width           =   495
   End
   Begin PictureBox picLZHopen
      Height          =   615
      Left            =   6840
      Picture         =   GETFILE.FRX:0302
      ScaleHeight     =   585
      ScaleWidth      =   465
      TabIndex        =   18
      Top             =   2400
      Width           =   495
   End
   Begin PictureBox picLZHClose
      Height          =   615
      Left            =   6840
      Picture         =   GETFILE.FRX:0604
      ScaleHeight     =   585
      ScaleWidth      =   465
      TabIndex        =   17
      Top             =   1560
      Width           =   495
   End
   Begin TextBox txtLZHname
      Height          =   375
      Left            =   5040
      TabIndex        =   16
      Top             =   3120
      Width           =   1215
   End
   Begin CommandButton btnTrash
      Caption         =   "&Trash"
      Height          =   495
      Left            =   5160
      TabIndex        =   15
      Top             =   2160
      Width           =   1095
   End
   Begin PictureBox picFile2
      Height          =   615
      Left            =   6960
      Picture         =   GETFILE.FRX:0906
      ScaleHeight     =   585
      ScaleWidth      =   465
      TabIndex        =   14
      Top             =   840
      Width           =   495
   End
   Begin PictureBox PicFile1
      Height          =   615
      Left            =   6960
      Picture         =   GETFILE.FRX:0C08
      ScaleHeight     =   585
      ScaleWidth      =   465
      TabIndex        =   13
      Top             =   120
      Width           =   495
   End
   Begin CommandButton cmdDelete
      Caption         =   "&Delete"
      Height          =   495
      Left            =   5160
      TabIndex        =   12
      Top             =   1560
      Width           =   1095
   End
   Begin CommandButton cmdCancel
      Cancel          =   -1  'True
      Caption         =   "&Cancel"
      Height          =   495
      Left            =   5160
      TabIndex        =   11
      Top             =   720
      Width           =   1095
   End
   Begin CommandButton cmdOK
      Caption         =   "&OK"
      Height          =   495
      Left            =   5160
      TabIndex        =   10
      Top             =   120
      Width           =   1095
   End
   Begin DirListBox dirDirectory
      Height          =   2280
      Left            =   2640
      TabIndex        =   9
      Top             =   720
      Width           =   2295
   End
   Begin DriveListBox drvDrive
      Height          =   315
      Left            =   2640
      TabIndex        =   5
      Top             =   3600
      Width           =   2295
   End
   Begin ComboBox cboFileType
      Height          =   300
      Left            =   240
      Style           =   2  'Dropdown List
      TabIndex        =   4
      Top             =   3600
      Width           =   2175
   End
   Begin FileListBox filFiles
      Height          =   2370
      Hidden          =   -1  'True
      Left            =   240
      TabIndex        =   2
      Top             =   720
      Width           =   2175
   End
   Begin TextBox txtFileName
      Height          =   285
      Left            =   240
      TabIndex        =   1
      Top             =   360
      Width           =   2175
   End
   Begin Label lblLZH
      Caption         =   "LHA File Name"
      Height          =   255
      Left            =   5040
      TabIndex        =   20
      Top             =   2880
      Width           =   1215
   End
   Begin Label lblDirName
      Height          =   255
      Left            =   2640
      TabIndex        =   8
      Top             =   360
      Width           =   1455
   End
   Begin Label lblDirectories
      Caption         =   "Directories:"
      Height          =   255
      Left            =   2640
      TabIndex        =   7
      Top             =   120
      Width           =   975
   End
   Begin Label lbDrive
      Caption         =   "Drive:"
      Height          =   255
      Left            =   2640
      TabIndex        =   6
      Top             =   3360
      Width           =   975
   End
   Begin Label lblFileType
      Caption         =   "File Type:"
      Height          =   255
      Left            =   240
      TabIndex        =   3
      Top             =   3360
      Width           =   735
   End
   Begin Label lblFileName
      Caption         =   "File Name:"
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   855
   End
End
Dim LZHstatus
Dim LZHname

Sub btnexit_Click ()
 End
End Sub

Sub btnTrash_Click ()

Dim Filenum As Integer
Dim Filesize As Integer

On Error GoTo JDELETE

If txtFileName.Text = "" Then
  Exit Sub
End If

'Insert drive and path name
procInsPath

'Get a free file number
Filenum = FreeFile

'Get file size
Filesize = FileLen(frmGetFile.Tag) - 2

If Filesize > 0 Then
If Filesize > szbuff Then
  Filesize = szbuff
 End If
 buffer = Space(Filesize)

 'Open file
 Open frmGetFile.Tag For Output As Filenum

 'Output spaces to file
 Print #Filenum, buffer

 'Close file
 Close Filenum
End If

JDELETE:
'Delete file
Kill frmGetFile.Tag
txtFileName.Text = ""

'Update file list
filFiles.Refresh

Exit Sub

End Sub

Sub btnTrash_DragDrop (Source As Control, X As Single, Y As Single)

btnTrash_Click

End Sub

Sub btnTrash_DragOver (Source As Control, X As Single, Y As Single, State As Integer)

Select Case State
  Case 0
    'change icon to release
     filFiles.DragIcon = picFile2
  Case 1
    'change icon to release
     filFiles.DragIcon = picFile1
End Select

End Sub

Sub cboFileType_Click ()

Dim patternpos1 As Integer
Dim patternpos2 As Integer
Dim patternlen As Integer
Dim Pattern As String

'Find starting position
patternpos1 = InStr(1, cbofiletype.Text, "(") + 1

'Find the end position
patternpos2 = InStr(1, cbofiletype.Text, ")") - 1

'Calculate the length of the pattern string
patternlen = patternpos2 - patternpos1 + 1

'Extract the pattern from the combo box
Pattern = Mid$(cbofiletype.Text, patternpos1, patternlen)

'set the pattern of the filfiles to the select pattern
filFiles.Pattern = Pattern


End Sub

Sub cmdCancel_Click ()

'Set the frmgetfile.tag to null
frmGetFile.Tag = ""

'Hide the frmgetfile
frmlha.Hide
frmGetFile.Hide

End Sub

Sub cmdDelete_Click ()

If txtFileName.Text = "" Then
  Exit Sub
End If

'Insert drive and path name
procInsPath

'Delete file
Kill frmGetFile.Tag
txtFileName.Text = ""

'Update file list
filFiles.Refresh

End Sub

Sub cmdDelete_DragDrop (Source As Control, X As Single, Y As Single)

cmdDelete_Click

End Sub

Sub cmdDelete_DragOver (Source As Control, X As Single, Y As Single, State As Integer)

Select Case State
  Case 0
    'change icon to release
     filFiles.D